;;########################################################################
;; efa-visualize.lsp
;;########################################################################

(defmeth efa-model-object-proto :visualize ()
  (if (not (eq current-object self)) (setcm self))
  (let* ((factor-load (column-list (send self :factor-load)))
         
         (nvar (send self :nvars))
         (nfactors (send self :nfactors))
         (rays (row-list (select (transpose (send self :factor-load))
                        (iseq nfactors) (iseq nvar))))
         (nobs (send self :nobs))   
         (factor-labels  (mapcar #'(lambda (x) (format nil "Factor~a" x)) (+ 1 (iseq nfactors))))
         (point-labels (send self :labels))
         (variable-labels (send self :variables))
         (evals (send current-model :init-eigenvalues))
           
         (proportions (/ evals (sum evals)))
         
         (scree (scree-plot proportions :show nil)) 
         (var-list (name-list variable-labels :title "Variables-List" :show nil))
         (scatterplot (plot-points factor-load
                      :point-labels nil :variable-labels factor-labels :title "Ray" :show nil))
       
         (scatterplot2 (plot-points  (send self :initial-COMMUNALITIES) (send self  :EXTRAC-COMMUNALITIES)  
                                     :point-labels variable-labels :variable-labels (list  "initial" "extracted") :title "commu" :show nil))
         
         (spin-plot (if (> nfactors 2)
              (spin-plot factor-load :point-labels nil :variable-labels factor-labels
                         :show nil)
              nil))
         (box (boxplot (* factor-load factor-load)
                            :show nil))
            
         
         (sp (spread-plot 
              (matrix '(2 5)
                      (list var-list spin-plot NIL scatterplot scree nil NIL NIL scatterplot2  box)) 
               :rel-widths (list .5 1 1 1 1) :span-down (matrix (list 2 5) (list 2 2 1 1 1 0 0 1 1 1)) :span-right (matrix (list 2 5) (list 1 2 0 1 1 1 1 0 1 1))
              )
             )
         )

;;;***List
    (send var-list :use-color t)
    (send var-list :point-color (iseq nvar) 'red)
    (send var-list :linked t)

;;;***box
   
    (send box :new-menu "Boxplot" :items '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR))
    (send box :linked t)
    (send box :showing-labels t)
    (send box  :point-color (iseq (* nvar nfactors)) 'red)
    (send box  :point-symbol (iseq (* nvar nfactors)) 'disk)
    (send box :SWITCH-MEAN-LINE)
    (send box :range 1 0 1)
    (send box :showing-labels t)
    (send box :connect-points t)
    (send box :mouse-mode 'brushing)
   

;;;***scatterplot2  
    
     (send scatterplot2 :showing-labels t)
    (send scatterplot2 :point-color (iseq nvar) 'red)
    (send scatterplot2 :mouse-mode 'brushing)
    (send scatterplot2 :plot-buttons)
    (send scatterplot2 :new-menu "Communalities" :items '(MOUSE SYMBOL))
    (send scatterplot2 :linked t)
    (send scatterplot2 :range 0 0 1)
    (send scatterplot2 :range 1 0 (max  (send self  :EXTRAC-COMMUNALITIES)))
    

;; ***scatterplot 
    (send scatterplot :clear-points)
    (send scatterplot :add-rays factor-load :ray-labels variable-labels  :ray-color 'red)
    (send scatterplot :adjust-scatterplot-to-data 'centroid-fixed) 
    (send scatterplot :plot-buttons)   
    (send scatterplot :add-grid)
    (send scatterplot :mouse-mode 'brushing)
    (send scatterplot :linked t)
    (send scatterplot :showing-labels t)
    (send scatterplot :menu-template 
      '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH SYMBOL COLOR line-width))
    (send scatterplot :new-menu)
    
 
 (defmeth scatterplot-proto :show-new-var (axis variable)
      (let* ((cur-var (send self :current-variables))
             (var-num (position variable (send self :variable-labels))))
        (if (equal axis "X") 
            (send self :current-variables var-num (second cur-var) :draw nil)
            (send self :current-variables (first cur-var) var-num :draw nil))
        (apply #' send self :y-axis (send self :y-axis))
        (send self :add-grid)
        (send self :redraw)))

;;;****spin-plot
 
    (send spin-plot  :clear-points)
    ;(send spin-plot :scale-type 'fixed);xls bug work-around
    (send spin-plot :mouse-mode 'hand-rotate)
    ;(send spin-plot :scale-constant 1.5 :draw nil)
    ;(send spin-plot :scale-type 'centroid-fixed)
    (send spin-plot :linked t)
    (send spin-plot :showing-labels t)
    (send spin-plot :mouse-mode 'brushing)
    (send spin-plot :menu-template 
                '(SHOWING-LABELS MOUSE RESIZE-BRUSH DASH 
                                 SYMBOL COLOR line-width DASH FASTER SLOWER AXES))
    (setf dimension-lengths 
                        (mapcar #'max (abs (send spin-plot :range (iseq nfactors )))))
    (setf rays-mat (matrix (list nfactors nvar) (combine rays)))
    (setf vector-lengths (sqrt (mapcar #'ssq (column-list rays-mat))))
    (setf spin-vector-ratio (sqrt (/ (^ (min dimension-lengths) 2)
                                     (^ (max vector-lengths) 2))))
    (setf rays (* rays spin-vector-ratio))
    (send spin-plot :add-rays rays :ray-labels variable-labels 
          :ray-color 'red)

 (defmeth spin-plot :show-new-var (axis variable)
   (let* ((var-num (position variable (send self :variable-labels)))
          (cur-vars (send self :current-variables))
          (cur-var-names nil)
          (idling (send self :idle-on))
          )
              (cond
                ((equal (string-downcase axis) "x") 
                 (setf (select cur-vars 0) var-num))
                ((equal (string-downcase axis) "y") 
                 (setf (select cur-vars 1) var-num))
                ((equal (string-downcase axis) "z") 
                 (setf (select cur-vars 2) var-num))
                )
     (setf cur-var-names (select (send self :variable-labels) cur-vars))
     (send self :idle-on nil)
     (send self :transformation nil)
     (apply #'send self :current-variables cur-vars)
     (send self :set-variables-with-labels cur-vars cur-var-names)
     (send self :redraw)
     (send self :idle-on idling)))

  
          

;=-=-=-=-= scree 
   (setf eigenvalues2 
          (mapcar #'(lambda (k)
                      (exp  (+ 
                             -0.130827
                             (* -0.444853 k)
                             (* -0.008497 (* k k)) 
                             (* 0.639462 (log nvar))
                             (* (* 0.059901 k) (log Nobs))
                             (* -0.078631 (* (log Nobs) (log nvar)))
                             (* (* 0.001488 (* k k)) (log Nvar))
                             (* (* 0.095875 k) (log nvar))
                             (* (* 0.001576 (* k k)) (log nvar))
                             (* (* -0.013331 k) (* (log Nobs) (log nvar)))
                             (* (* -0.000278 (* k k)) (* (log Nobs) (log nvar)))
                             ))) (iseq nvar)))
         (setf prop2 (/ eigenvalues2 (sum eigenvalues2)))

    (send scree :add-lines 
              (list (+ 1 (iseq nvar)) prop2) :draw nil :color 'dark-green)
    (send scree :variable-label 1 "Proportion")
    (send scree :range 1 0 
          (/ (ceiling (* 10 (select proportions 0))) 10) )      
    (send scree :x-axis t 0 (+ nvar 1))
    (send scree :range 0 0 nvar)
    (send scree :plot-buttons :mouse-mode nil :new-x nil :new-y nil)
    ;(send sp :size 600 600)
    (send sp :show-spreadplot)
    t)
  )

(defun scree-plot (eigenvalues &key location size)
"Args: (eigenvalues)
Takes an eigenvalue sequence, produces a scree-plot, returns a plot-object."
   (let* ((n (length eigenvalues))
          (prop (/ eigenvalues (sum eigenvalues)))
          (scree-plot (plot-points (+ 1 (iseq n)) prop
                :show nil :title "Scree Plot"
                :variable-labels '("Principal Components" "Proportion")))
          (maxy (select prop 0))
          (cum-prop (cumsum prop)))
     (send scree-plot :add-lines 
           (list (+ 1 (iseq n)) prop) :draw nil :color 'red)
     (send scree-plot :point-color (iseq n) 'red)
     (mapcar #'(lambda (i)
                 (send scree-plot :point-label i
                       (cond
                         ((> i 0) 
                          (format nil "~5,4f, ~5,4f, ~5,4f" 
                                  (select prop i) 
                                  (- (select prop (- i 1)) (select prop i) )
                                  (select cum-prop i)))
                         (t
                          (format nil "~5,4f" (select prop i))))))
             (iseq (send scree-plot :num-points)))
     (send scree-plot :range 1 0  (* .1 (ceiling (* 10 maxy))) :draw nil)
     (send scree-plot :y-axis t t (1+   (ceiling (* 10 maxy))) :draw t)
     (send scree-plot :showing-labels t)
     (send scree-plot :mouse-mode 'brushing)
     (send scree-plot :menu nil)
     (send scree-plot :point-state 0 'selected)
     (send scree-plot :adjust-to-data :draw nil)

     (defmeth scree-plot :plot-help ()
       (plot-help-window (strcat "Help for " (send self :title)))
       (paste-plot-help (format nil "The Scree plot shows the relative fit of each principal component. It does this by plotting the proportion of the data's variance that is fit by each component versus the component's number. The plot shows the relative importance of each component in fitting the data.~2%"))
       (paste-plot-help (format nil "The numbers beside the points provide information about the fit of each component. The first number is the proportion of the data's variance that is accounted for by the component. The second number is the difference in variance from the previous component. The third number is the total proportion of variance accounted for by the component and the preceeding components.~2%"))
       (paste-plot-help (format nil "The Scree plot can be used to aid in the decision about how many components are useful. You use it to make this decision by looking for an elbow (bend) in the curve. If there is one (and there often isn't) then the components following the bend account for relatively little additional variance, and can perhaps be ignored.~2%"))
       (show-plot-help))
     scree-plot))
